home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
INTERCOM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-28
|
11KB
|
295 lines
UNIT InterCom;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Intercommunication routies Last changed: 28.04.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-96 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, PopTypes;
FUNCTION OpenInterCom(TaskNum: Byte; CONST Address: TFidoAddress): Boolean;
PROCEDURE CloseInterCom;
FUNCTION SetInterCom(Status: Byte; CONST InAdr: TFidoAddress; Ask: Boolean): Boolean;
FUNCTION GetInterCom(TaskNum: Byte; Var ICR: TInterCom): Boolean;
FUNCTION GetMaxLines: Byte;
FUNCTION ICStatusStr(CONST ICR: TInterCom): String;
PROCEDURE SetToDoFlags(Flag: Word);
FUNCTION CheckICToDo(Flag: Word): Boolean;
IMPLEMENTATION
USES Dos, OpString,
Globals, NetFile, LogFile, StrUtil, MTask, MailUtil;
CONST
InterComFile: PNetFile = NIL;
VAR
ICTaskNum : Byte;
FUNCTION GetMaxLines: Byte;
BEGIN
GetMaxLines:=InterComFile^.FileSize;
END;
FUNCTION GetInterCom(TaskNum: Byte; Var ICR: TInterCom): Boolean;
BEGIN
InterComFile^.GetRec(ICR, TaskNum, NoKeep, Wait);
GetInterCom:=(InterComFile^.IoResult=0);
END;
FUNCTION CheckICToDo(Flag: Word): Boolean;
VAR
IC:TInterCom;
BEGIN
REPEAT
GiveUpTime;
UNTIL GetInterCom(ICTaskNum,IC);
CheckICToDo:=(IC.ToDoFlags AND Flag)<>0;
IC.ToDoFlags:=IC.ToDoFlags AND (NOT Flag);
InterComFile^.PutRec(IC,ICTaskNum);
END;
FUNCTION SetInterCom(Status: Byte; CONST InAdr: TFidoAddress; Ask: Boolean): Boolean;
VAR
i, Tries : Byte;
GotIt : Boolean;
TmpICRec : TInterCom;
HaveConflict: Boolean;
InterComRec : TInterCom;
FUNCTION Informal(Status: Byte): Boolean;
BEGIN
Informal:=(Status<$80);
END;
FUNCTION Conflict(CONST TmpICRec,InterComRec: TInterCom; Ask: Boolean): Boolean ;
VAR
s: String ;
BEGIN
Conflict:=False ;
s:=' line '+Long2Str(i);
CASE TmpICRec.Status OF
ICPolling : IF CmpAdr(TmpICRec.PollAddress,InterComRec.PollAddress) THEN
BEGIN
CASE InterComRec.Status OF
ICPolling : BEGIN
Conflict:=True ;
AddLog(':','Node is being polled by'+s) ;
END ;
ICConnect : BEGIN
Conflict:=True ;
AddLog(':','Node is connected to'+s) ;
END ;
END ;
END;
ICFileFwd : CASE InterComRec.Status OF
ICFileFwd : BEGIN
Conflict:=True ;
AddLog(':','Files are being forwarded on'+s) ;
END ;
END;
ICConnect : IF CmpAdr(TmpICRec.PollAddress,InterComRec.PollAddress) THEN
BEGIN
CASE InterComRec.Status OF
ICPolling : BEGIN
Conflict:=True ;
AddLog(':','Node is connected to'+s) ;
END ;
ICConnect : BEGIN
Conflict:=True ;
AddLog(':','Node is connected to'+s+' ????') ;
END ;
END ;
END;
ICNLComp : CASE InterComRec.Status OF
ICNLComp : BEGIN
Conflict:=True ;
AddLog(':','Nodelist is being compiled by'+s) ;
END ;
ICNLMan : BEGIN
Conflict:=True ;
AddLog(':','Nodelist manager is in use on'+s) ;
END ;
END;
ICUnpackMail : CASE InterComRec.Status OF
ICUnpackMail : BEGIN
Conflict:=True ;
{ InterComRec.ToDoFlags:=ICTDUnpackMail;}
AddLog(':','Mail is being unpacked by'+s) ;
END ;
END;
ICOutMan : CASE InterComRec.Status OF
ICOutMan : BEGIN
Conflict:=True ;
AddLog(':','Outman is in use on'+s) ;
END ;
END;
ICNLMan : CASE InterComRec.Status OF
ICNLComp : BEGIN
Conflict:=True ;
AddLog(':','Nodelist is being compiled by'+s) ;
END ;
ICNLMan : BEGIN
Conflict:=True ;
AddLog(':','Nodelist manager is in use on'+s) ;
END ;
END;
ICUserEd : CASE InterComRec.Status OF
ICUserEd : BEGIN
Conflict:=True;
AddLog(':','Usereditor in use on'+s)
END;
END;
ICScanNetMail: CASE InterComRec.Status OF
ICScanNetMail : BEGIN
Conflict:=True;
AddLog(':','Netmail is being scanned on'+s)
END;
END;
ICTick : CASE InterComRec.Status OF
ICTick : BEGIN
Conflict:=True;
AddLog(':','Tick''s are being processed on'+s)
END;
END;
END ;
END ;
BEGIN
SetInterCom:=False;
OpenLockFile;
Tries:=0;
REPEAT
GotIt:=NetGrabFile(NetICFile);
Inc(Tries);
UNTIL GotIt OR (Tries=5);
IF GotIt THEN
BEGIN
InterComFile^.GetRec(InterComRec, ICTaskNum, Keep, Wait);
InterComRec.Status:=Status;
InterComRec.PollAddress:=InAdr;
HaveConflict:=False;
IF Not Informal(Status) THEN
BEGIN
i:=0 ;
REPEAT
IF i<>IcTaskNum THEN
BEGIN
InterComFile^.GetRec(TmpICRec, i, NoKeep, Wait);
IF Conflict(TmpICRec,InterComRec,Ask) THEN HaveConflict:=True;
END;
Inc(i) ;
UNTIL (i>=GetMaxLines) OR (HaveConflict);
END;
IF Not HaveConflict THEN
BEGIN
SetInterCom:=True;
END ELSE
BEGIN
InterComRec.Status:=ICIdle;
END;
InterComFile^.PutRec(InterComRec, ICTaskNum);
NetReleaseFile(NetICFile);
END ELSE
AddLog('!','Can not access the intercom file');
CloseLockFile;
END;
FUNCTION OpenInterCom(TaskNum: Byte; CONST Address: TFidoAddress): Boolean;
VAR
i : Byte;
InterComRec : TInterCom;
BEGIN
New(InterComFile, Open(StartPath+PoPInterComFileName, SizeOf(InterComRec), True));
IF InterComFile<>NIL THEN
BEGIN
IF TaskNum=0 THEN TaskNum:=1;
IF InterComFile^.FileSize<TaskNum+1 THEN
BEGIN
FillChar(InterComRec,Sizeof(InterComRec),0);
InterComRec.Status:=ICUnused;
FOR i:=InterComFile^.FileSize TO TaskNum DO
InterComFile^.PutRec(InterComRec,i);
InterComFile^.Close;
InterComFile^.Open(StartPath+PoPInterComFileName, SizeOf(InterComRec), True);
END;
InterComFile^.GetRec(InterComRec,TaskNum,NoKeep,Wait);
ICTaskNum:=TaskNum;
WITH InterComRec DO
BEGIN
Status:=ICIdle;
MyAddress:=Address;
InterComFile^.PutRec(InterComRec,TaskNum);
END ;
OpenInterCom:=True;
END ELSE
OpenInterCom:=False;
END;
PROCEDURE CloseInterCom;
BEGIN
IF InterComFile<>NIL THEN InterComFile^.Close;
InterComFile:=NIL;
END;
FUNCTION ICStatusStr(CONST ICR: TInterCom): String;
BEGIN
WITH ICR DO
BEGIN
CASE Status OF
ICUnused : ICStatusStr:='Unused';
ICIdle : ICStatusStr:='Idle';
ICPolling : ICStatusStr:='Polling node '+Address2Str(PollAddress);
ICFileFwd : ICStatusStr:='Forwarding files';
ICConnect : ICStatusStr:='Connected to '+Address2Str(PollAddress);
ICNLComp : ICStatusStr:='Compiling nodelist';
ICUnpackMail : ICStatusStr:='Unpacking mail';
ICOutMan : ICStatusStr:='Using Outbound-manager';
ICNLMan : ICStatusStr:='Using Nodelist-manager';
ICAreaMan : ICStatusStr:='Using Areamanager';
ICTextEdit : ICStatusStr:='Editing a textfile';
ICMsgEdit : ICStatusStr:='Reading messages';
ICDumbTerm : ICStatusStr:='Using DumbTerminal';
ICDosShell : ICStatusStr:='In a DOS-Shell';
ICConfig : ICStatusStr:='Configuring the system';
ICSemExit : ICStatusStr:='Semafore exit with errorlevel '+Long2Str(PollAddress.Zone);
ICUserInBBS : ICStatusStr:='User On-Line';
ICScanNetMail: ICStatusStr:='Scanning Netmail';
ICTick : ICStatusStr:='Processing Tick files';
ELSE ICStatusStr:='Unknown status?';
END;
END;
END;
PROCEDURE SetToDoFlags(Flag:WORD);
VAR
i:BYTE;
IC:TInterCom;
BEGIN
OpenLockFile;
REPEAT
GiveUpTime;
UNTIL NetGrabFile(NetICFile);
FOR i:=0 TO GetMaxLines DO
IF i<>ICTaskNum THEN
BEGIN
GetInterCom(i,IC);
IC.ToDoFlags:=IC.ToDoFlags OR Flag;
InterComFile^.PutRec(IC, i);
END;
NetReleaseFile(NetICFile);
CloseLockFile;
END;
END.